home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DBASE_UT
/
INDX18EU
/
INDEXEDF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-20
|
22KB
|
917 lines
UNIT IndexedFiles ;
INTERFACE
{
***********************************************************************
AUTHOR : Thomas E. Jenkins, Jr.
VERSION : 1.5 10 JAN 1991
CONTACT : BITNET : C0361 @ UNIVSCVM
INTERNET : C0361 @ UNIVSCVM.CSD.SCAROLINA.EDU
S-MAIL : Tom Jenkins
9732 Windsor Lake Blvd.
Columbia, SC 29223
Voice : (803) 777-6666 ( Ask for Tom Jenkins )
***********************************************************************
THIS MODULE:
UNIT : IndexedFiles PC : INDEXEDF.PAS
USES :
UNIT : Files PC : FILES .PAS
***********************************************************************
This unit will index any record you design. The only draw back is that
the very first element of your record MUST be a string [ 10 ] . This is
the index. You must supply a unique index here to insert a new record,
or simply enter an existing index to replace the record in the indexed
file.
There are replacements to the standard turbo file procedures and functions
to deal with the index files. There is a new file type exported by this
unit as well.
Here is an example of how to create a index file:
Define record with index.
Declare variable of type IFile.
Call AssignIndexed with IFile variable and file name.
Call ReWriteIndexed with IFile
And now you have an indexed file! See READ.ME file for more information.
ReadIndexed and WriteIndexed will place data in your file. The indexing
is up to you, but the index file is automatic and requires no ( read DO
NOT ) tampering! See READ.ME file for more information.
There is an exporteded variable:
The type is WORD, fileError, set to 0. This variable is updated
with one of the constants with this unit. The variable IS NOT reset by
the unit until a new unit routine is called.
There are also several constants exported by the unit. See the READ.ME
file for more information.
}
CONST
NO_ERROR = 0 ;
CONST
NOT_ENOUGH_MEMORY = 1 ;
CONST
READ_LESS_BYTES_THAN_EXPECTED = 2 ;
CONST
INDEX_NOT_FOUND = 3 ;
CONST
LESS_BYTES_WRITTEN_THAN_EXPECTED = 4 ;
CONST
INVALID_FILE_NAME = 5 ;
TYPE
IndexStr = STRING [ 010 ] ;
IFile = RECORD
baseFile : FILE ;
indexFile : FILE ;
fileName : STRING ;
END ; { IFile }
TYPE
IndexType = RECORD
index : IndexStr ;
position : LONGINT ;
END ; { IndexType }
VAR
fileError : WORD ;
PROCEDURE ReadIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
PROCEDURE WriteIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
PROCEDURE DeleteIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
PROCEDURE ResetIndexed ( VAR f : IFile ) ;
PROCEDURE ReWriteIndexed ( VAR f : IFile ) ;
PROCEDURE CloseIndexed ( VAR f : IFile ) ;
FUNCTION FilePosIndexed ( VAR f : IFile ;
size : WORD )
: LONGINT ;
PROCEDURE AssignIndexed ( VAR f : IFile ;
indexFile : STRING ) ;
FUNCTION FileSizeIndexed ( VAR f : IFile ;
size : WORD )
: LONGINT ;
FUNCTION IndexFileSize ( VAR f : FILE )
: LONGINT ;
PROCEDURE IndexSeek ( VAR f : FILE ;
position : LONGINT ) ;
PROCEDURE IndexRead ( VAR f : FILE ;
VAR tempIndex : IndexType ) ;
FUNCTION IndexedError ( errorNum : WORD )
: STRING ;
IMPLEMENTATION
USES
DOS ,
CRT ,
Files ;
FUNCTION IndexFileSize ( VAR f : FILE )
: LONGINT ;
BEGIN { IndexFileSize }
IndexFileSize := FileSize ( f ) DIV SizeOf ( IndexType ) ;
END ; { IndexFileSize }
PROCEDURE IndexReset ( VAR i : FILE ) ;
BEGIN { IndexReset }
Reset ( i , 1 ) ;
END ; { IndexReset }
PROCEDURE IndexSeek ( VAR f : FILE ;
position : LONGINT ) ;
BEGIN { IndexSeek }
Seek ( f , ( position * SizeOf ( IndexType ) ) ) ;
END ; { IndexSeek }
PROCEDURE IndexRead ( VAR f : FILE ;
VAR tempIndex : IndexType ) ;
VAR
numRead : WORD ;
BEGIN { IndexRead }
BlockRead ( f , tempIndex , SizeOf ( IndexType ) , numRead ) ;
IF ( numRead < SizeOf ( IndexType ) )
THEN
fileError := READ_LESS_BYTES_THAN_EXPECTED ;
END ; { IndexRead }
PROCEDURE IndexWrite ( VAR f : FILE ;
index : IndexType ) ;
VAR
numWritten : WORD ;
BEGIN { IndexWrite }
BlockWrite ( f , index , SizeOf ( IndexType ) , numWritten ) ;
IF ( numWritten < SizeOf ( IndexType ) )
THEN
fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;
END ; { IndexWrite }
FUNCTION SearchIndex ( VAR f : IFile ;
index : IndexStr ;
VAR indexPosition : LONGINT )
: LONGINT ;
VAR
highRecord : LONGINT ;
lowRecord : LONGINT ;
tempSearch : LONGINT ;
indexNotFound : BOOLEAN ;
tempIndex : IndexType ;
BEGIN { SearchIndex }
highRecord := IndexFileSize ( f.indexFile ) ;
IF ( highRecord < 1 )
THEN
BEGIN
SearchIndex := -1 ;
Exit ;
END ; { IF }
IF ( highRecord = 1 )
THEN
BEGIN
indexPosition := 0 ;
IndexSeek ( f.indexFile , indexPosition ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index = index )
THEN
SearchIndex := tempIndex.position
ELSE
SearchIndex := -1 ;
Exit ;
END ; { IF }
indexNotFound := TRUE ;
lowRecord := 0 ;
Dec ( highRecord ) ; { record position filesize - 1 }
indexPosition := Trunc ( ( highRecord - lowRecord ) / 2 ) ;
WHILE (
( indexNotFound )
AND
( lowRecord <> highRecord )
)
DO
BEGIN
IndexSeek ( f.indexFile , indexPosition ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index = index )
THEN
indexNotFound := FALSE
ELSE
IF ( tempIndex.index > index )
THEN
BEGIN
IF ( highRecord = indexPosition )
THEN
lowRecord := highRecord
ELSE
BEGIN
highRecord := indexPosition ;
indexPosition :=
lowRecord +
Trunc ( ( highRecord - lowRecord ) / 2 ) ;
END ; { ELSE }
END { IF }
ELSE
BEGIN
IF ( lowRecord = indexPosition )
THEN
highRecord := lowRecord
ELSE
BEGIN
lowRecord := indexPosition ;
indexPosition :=
lowRecord +
Round ( ( highRecord - lowRecord ) / 2 ) ;
END ; { ELSE }
END ; { ELSE }
END ; { WHILE }
IF ( indexNotFound )
THEN
SearchIndex := -1
ELSE
SearchIndex := tempIndex.position ;
END ; { SearchIndex }
FUNCTION FileSizeIndexed ( VAR f : IFile ;
size : WORD )
: LONGINT ;
BEGIN { FileSizeIndexed }
fileError := NO_ERROR ;
FileSizeIndexed := ( FileSize ( f.baseFile ) DIV size ) ;
END ; { FileSizeIndexed }
PROCEDURE InsertIndex ( VAR f : IFile ;
index : IndexStr ;
position : LONGINT ) ;
VAR
newIndex : IndexType ;
numWritten : WORD ;
highRecord : LONGINT ;
lowRecord : LONGINT ;
searchRecord : LONGINT ;
tempSearch : LONGINT ;
tempIndex : IndexType ;
BEGIN { InsertIndex }
newIndex.index := index ;
newIndex.position := position ;
highRecord := IndexFileSize ( f.indexFile ) ;
IF ( highRecord < 1 )
THEN
BEGIN
IndexSeek ( f.indexFile , highRecord ) ;
IndexWrite ( f.indexFile , newIndex ) ;
Exit ;
END ; { IF }
IF ( highRecord <= 1 )
THEN
BEGIN
IndexSeek ( f.indexFile , 0 ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index < newIndex.index )
THEN
IndexWrite ( f.indexFile , newIndex )
ELSE
InsertRecord ( f.indexFile ,
newIndex , 0 , SizeOf ( newIndex ) ) ;
Exit ;
END ; { IF }
IF ( highRecord <= 2 )
THEN
BEGIN
IndexSeek ( f.indexFile , 0 ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index > newIndex.index )
THEN
BEGIN
InsertRecord ( f.indexFile ,
newIndex , 0 , SizeOf ( newIndex ) ) ;
Exit ;
END ; { THEN }
IndexSeek ( f.indexFile , 1 ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index > newIndex.index )
THEN
BEGIN
InsertRecord ( f.indexFile ,
newIndex , 1 , SizeOf ( newIndex ) ) ;
Exit ;
END ; { THEN }
IndexSeek ( f.indexFile , 2 ) ;
IndexWrite ( f.indexFile , newIndex ) ;
Exit ;
END ; { IF }
lowRecord := 0 ;
Dec ( highRecord ) ; { record position filesize - 1 }
searchRecord := Trunc ( ( highRecord - lowRecord ) / 2 ) ;
WHILE ( ( ( highRecord - 1 ) > searchRecord ) AND
( ( lowRecord + 1 ) < searchRecord ) )
DO
BEGIN
IndexSeek ( f.indexFile , searchRecord ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index > newIndex.index )
THEN
BEGIN
IF ( highRecord = searchRecord )
THEN
lowRecord := highRecord
ELSE
BEGIN
highRecord := searchRecord ;
searchRecord :=
lowRecord +
Trunc ( ( highRecord - lowRecord ) / 2 ) ;
END ; { ELSE }
END { IF }
ELSE
BEGIN
IF ( lowRecord = searchRecord )
THEN
highRecord := lowRecord
ELSE
BEGIN
lowRecord := searchRecord ;
searchRecord :=
lowRecord +
Round ( ( highRecord - lowRecord ) / 2 ) ;
END ; { ELSE }
END ; { ELSE }
END ; { WHILE }
searchRecord := lowRecord ;
REPEAT
IndexSeek ( f.indexFile , searchRecord ) ;
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.index < newIndex.index )
THEN
Inc ( searchRecord ) ;
UNTIL ( ( tempIndex.index > newIndex.index ) OR
( searchRecord > highRecord ) OR
( searchRecord >= IndexFileSize ( f.indexfile ) ) ) ;
InsertRecord ( f.indexFile ,
newIndex , searchRecord , SizeOf ( newIndex ) )
END ; { InsertIndex }
PROCEDURE ResetIndexed ( VAR f : IFile ) ;
BEGIN { ResetIndexed }
Reset ( f.baseFile , 1 ) ;
Reset ( f.indexFile , 1 ) ;
fileError := NO_ERROR ;
END ; { ResetIndexed }
PROCEDURE ReWriteIndexed ( VAR f : IFile ) ;
BEGIN { ReWriteIndexed }
ReWrite ( f.baseFile , 1 ) ;
ReWrite ( f.indexFile , 1 ) ;
fileError := NO_ERROR ;
END ; { ReWriteIndexed }
PROCEDURE SeekIndexed ( VAR f : IFile ;
position : LONGINT ;
size : WORD ) ;
BEGIN { SeekIndexed }
fileError := NO_ERROR ;
Seek ( f.baseFile , ( position * size ) ) ;
END ; { SeekIndexed }
PROCEDURE ReadIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
VAR
position : LONGINT ;
index : IndexStr
ABSOLUTE
BUFFER ;
numRead : WORD ;
indexPosition : LONGINT ;
BEGIN { ReadIndexed }
fileError := NO_ERROR ;
position := SearchIndex ( f , index , indexPosition ) ;
IF ( position < 0 )
THEN
BEGIN
fileError := INDEX_NOT_FOUND ;
Exit ;
END ; { IF }
SeekIndexed ( f , position , size ) ;
BlockRead ( f.baseFile , buffer , size , numRead ) ;
IF ( numRead < size )
THEN
fileError := READ_LESS_BYTES_THAN_EXPECTED ;
END ; { ReadIndexed }
FUNCTION IndexFilePos ( VAR f : FILE )
: LONGINT ;
BEGIN { IndexFilePos }
IndexFilePos := FilePos ( f ) DIV SizeOf ( IndexType ) ;
END ; { IndexFilePos }
PROCEDURE WriteIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
VAR
position : LONGINT ;
index : IndexStr
ABSOLUTE
BUFFER ;
numWritten : WORD ;
indexPosition : LONGINT ;
BEGIN { WriteIndexed }
fileError := NO_ERROR ;
position := SearchIndex ( f , index , indexPosition ) ;
IF ( position >= 0 )
THEN
BEGIN
SeekIndexed ( f , position , size ) ;
BlockWrite ( f.baseFile , buffer , size , numWritten ) ;
IF ( numWritten < size )
THEN
fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;
Exit ;
END ; { IF }
SeekIndexed ( f , FileSizeIndexed ( f , size ) , size ) ;
BlockWrite ( f.baseFile , buffer , size , numWritten ) ;
IF ( numWritten < size )
THEN
fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;
InsertIndex ( f , index , FilePosIndexed ( f , size ) - 1 ) ;
END ; { WriteIndexed }
PROCEDURE CloseIndexed ( VAR f : IFile ) ;
BEGIN { CloseIndexed }
fileError := NO_ERROR ;
Close ( f.baseFile ) ;
Close ( f.indexFile ) ;
END ; { CloseIndexed }
FUNCTION FilePosIndexed ( VAR f : IFile ;
size : WORD )
: LONGINT ;
BEGIN { FilePosIndexed }
fileError := NO_ERROR ;
FilePosIndexed := FilePos ( f.baseFile ) DIV size ;
END ; { FilePosIndexed }
PROCEDURE AssignIndexed ( VAR f : IFile ;
indexFile : STRING ) ;
CONST
INDEX_EXT = 'IDX' ;
FILE__EXT = 'FIL' ;
VAR
dotPosition : BYTE ;
BEGIN { AssignIndexed }
fileError := NO_ERROR ;
IF ( indexFile = '' )
THEN
BEGIN
fileError := INVALID_FILE_NAME ;
END ; { IF }
dotPosition := Pos ( '.' , indexFile ) ;
IF ( dotPosition <> 0 )
THEN
BEGIN
fileError := INVALID_FILE_NAME ;
Exit ;
END ; { IF }
Assign ( f.indexFile , indexFile + '.' + INDEX_EXT ) ;
Assign ( f.baseFile , indexFile + '.' + FILE__EXT ) ;
f.fileName := indexFile ;
END ; { AssignIndexed }
PROCEDURE DeleteIndexed ( VAR f : IFile ;
VAR buffer ;
size : WORD ) ;
VAR
position : LONGINT ;
index : IndexStr
ABSOLUTE
BUFFER ;
numWritten : WORD ;
indexPosition : LONGINT ;
tempIndex : IndexType ;
BEGIN { DeleteIndexed }
fileError := NO_ERROR ;
position := SearchIndex ( f , index , indexPosition ) ;
IF ( position < 0 )
THEN
BEGIN
fileError := INDEX_NOT_FOUND ;
Exit ;
END ; { IF }
DeleteRecord ( f.baseFile , position , size ) ;
DeleteRecord ( f.indexFile , indexPosition , SizeOf ( IndexType ) ) ;
IndexReset ( f.indexFile ) ;
WHILE ( NOT ( EOF ( f.indexFile ) ) )
DO
BEGIN
IndexRead ( f.indexFile , tempIndex ) ;
IF ( tempIndex.position > indexPosition )
THEN
BEGIN
Dec ( tempIndex.position ) ;
IndexSeek ( f.indexFile , IndexFilePos ( f.indexFile ) - 1 ) ;
IndexWrite ( f.indexFile , tempIndex ) ;
END ; { THEN }
END ; { WHILE }
END ; { DeleteIndexed }
FUNCTION IndexedError ( errorNum : WORD )
: STRING ;
BEGIN { IndexedError }
CASE errorNum
OF
NO_ERROR :
IndexedError := 'no error' ;
NOT_ENOUGH_MEMORY :
IndexedError := 'not enough memory to complete operation' ;
READ_LESS_BYTES_THAN_EXPECTED :
IndexedError := 'file read error' ;
INDEX_NOT_FOUND :
IndexedError := 'index was not found' ;
LESS_BYTES_WRITTEN_THAN_EXPECTED :
IndexedError := 'file write error' ;
INVALID_FILE_NAME :
IndexedError := 'file name invalid' ;
ELSE
IndexedError := 'FATAL ERROR!! Unknown error!' ;
END ; { CASE errorNum }
END ; { IndexedError }
BEGIN
fileError := 0 ;
END .
